home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / editor / wabd101.zip / WABD101.ZIP / TraceUnit.pas < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  3KB  |  105 lines
  1. unit TraceUnit;
  2.  
  3. interface
  4.  
  5. uses  Forms, Classes, SysUtils, OleAuto, Windows, Messages;
  6.  
  7. procedure Trace(s: string; p: array of const);
  8. procedure Trace0(s: string);
  9.  
  10. implementation
  11.  
  12. {$IFDEF TRACESERVER}
  13. uses TraceMsg;
  14.  
  15. var
  16.    Tracer         : Variant;
  17.    MsgWnd         : HWND;
  18.    SharedMutex    : THandle;
  19.    SharedFileMap  : THandle;
  20.    SharedEvent    : THandle;
  21.    OtherProcess   : THandle;
  22.    OtherProcessID : integer;
  23.    MyMutex        : THandle;
  24.    MyFileMap      : THandle;
  25.    MyEvent        : THandle;
  26.    FilePtr        : pointer;
  27.    Ring           : TSharedRing;
  28.    rc             : boolean;
  29. {$ENDIF}
  30.  
  31. var
  32.    TraceLoaded    : boolean;
  33.    TraceIsDone    : boolean;
  34.    TraceFile      : TFileStream;
  35.  
  36. procedure Trace0(s: string);
  37. const
  38.    CR = #13#10;
  39. var
  40.    tmp : string;
  41. begin
  42.    if TraceIsDone then exit;
  43.    
  44.    if TraceLoaded then begin
  45.       {$IFDEF TRACESERVER}
  46.       s := Copy(s, 1, sizeof(TRingStr)-1);
  47.       while not Ring.Push(s) do Sleep(100);
  48.       SetEvent(MyEvent);
  49.       {$ENDIF}
  50.    end else begin
  51.       tmp := s + CR;
  52.       TraceFile.Write(tmp[1], Length(tmp));
  53.    end;
  54. end;
  55.  
  56. procedure Trace(s: string; p: array of const);
  57. begin
  58.    Trace0(Format(s, p));
  59. end;
  60.  
  61.  
  62. initialization
  63.    TraceIsDone := False;
  64.    TraceLoaded := False;
  65.  
  66. try
  67.    {$IFDEF TRACESERVER}
  68.    Tracer := CreateOleObject('TraceServ.Output');
  69.    MsgWnd := Tracer.GetTraceHandle;
  70.    SetFocus(Application.Handle);
  71.  
  72.    SharedMutex     := Tracer.GetMutexHandle;
  73.    SharedFileMap   := Tracer.GetFileMapHandle;
  74.    SharedEvent     := Tracer.GetEventHandle;
  75.    OtherProcessID  := Tracer.GetProcessID;
  76.    OtherProcess    := OpenProcess(STANDARD_RIGHTS_REQUIRED, False, OtherProcessID);
  77.  
  78.    rc := DuplicateHandle(OtherProcess, SharedEvent, GetCurrentProcess, @MyEvent, EVENT_ALL_ACCESS, False, 0);
  79.    if rc=FALSE then raise Exception.Create('Could not duplicate Event');
  80.    rc := DuplicateHandle(OtherProcess, SharedMutex, GetCurrentProcess, @MyMutex, MUTEX_ALL_ACCESS, False, 0);
  81.    if rc=FALSE then raise Exception.Create('Could not duplicate Mutex');
  82.    rc := DuplicateHandle(OtherProcess, SharedFileMap, GetCurrentProcess, @MyFileMap, FILE_MAP_ALL_ACCESS, False, 0);
  83.    if rc=FALSE then raise Exception.Create('Could not duplicate FileMap');
  84.  
  85.    FilePtr := MapViewOfFile(MyFileMap, FILE_MAP_WRITE, 0, 0, 0);
  86.    Ring    := TSharedRing.Create(MyMutex, FilePtr);
  87.    TraceLoaded := True;
  88.    {$ENDIF}
  89. except
  90.    on Exception do begin end;
  91. end;
  92.    if not TraceLoaded then
  93.       TraceFile := TFileStream.Create('TraceFile.txt', fmCreate or fmShareDenyWrite);
  94.  
  95. finalization
  96.    {$IFDEF TRACESERVER}
  97.    if Ring<>nil then Ring.Free;
  98.    CloseHandle(MyMutex);
  99.    CloseHandle(MyFileMap);
  100.    CloseHandle(MyEvent);
  101.    {$ENDIF}
  102.    if TraceFile<>nil then TraceFile.Free;
  103. end.
  104.  
  105.